home *** CD-ROM | disk | FTP | other *** search
/ Internet Surfer: Getting Started / Internet Surfer - Getting Started (Wayzata Technology)(7231)(1995).bin / pc / mac / bonus / peter_le / chat__ / tcp_libr / tcpstuff.uni < prev    next >
Text File  |  1992-12-10  |  24KB  |  783 lines
  1. unit TCPStuff;
  2.  
  3. { From Peter's PNL Libraries }
  4. { Copyright 1992 Peter N Lewis }
  5. { This source may be used for any non-commercial purposes as long as I get a mention }
  6. { in the About box and Docs of any derivative program.  It may not be used in any commercial }
  7. { application without my permission }
  8.  
  9. interface
  10.  
  11.     uses
  12.         TCPTypes;
  13.  
  14.     const
  15.         Minimum_TCPBUFFERSIZE = 4096;
  16.         Default_TCPBUFFERSIZE = longInt(6) * 1024;
  17.     { Amount of space to allocate for each TCP connection }
  18.         INCOMINGBUFSIZE = 100;    { Incoming buffer size, used for buffering ReceiveUpTo. }
  19.         control_block_max = 260;
  20.         tooManyControlBlocks = -23098;
  21.  
  22.     type
  23.         OSErrPtr = ^OSErr;
  24.  
  25. { TCP connection description: }
  26.         TCPConnectionType = record
  27.                 magic: OSType;    { A magic number to try and avoid problems with released connection IDs. }
  28.                 stream: StreamPtr;
  29.                 closedone: boolean;
  30.                 laststate: integer;
  31.                 asends, asendcompletes: longInt;
  32.                 closeuserptr: OSErrPtr;
  33.                 incomingPtr: Ptr;                                { Pointer into inBuf of next byte to read. }
  34.                 incomingSize: longInt;                        { Number of bytes left in inBuf. }
  35.                 buffer: ptr;        { connection buffer. }
  36.                 inBuf: array[1..INCOMINGBUFSIZE] of SignedByte;    {Input buffer. }
  37.             end;
  38.         TCPConnectionPtr = ^TCPConnectionType;
  39.  
  40.         MyControlBlock = record
  41.                 tcp: TCPControlBlock;
  42.                 inuse: boolean;
  43.                 userptr: OSErrPtr;
  44.                 proc: procPtr;
  45.                 tcpc: TCPConnectionPtr;
  46.             end;
  47.         MyControlBlockPtr = ^MyControlBlock;
  48.  
  49.  
  50.         TCPStateType = (T_WaitingForOpen, T_Closed, T_Listening, T_Opening, T_Established,{}
  51.             T_Closing, T_PleaseClose, T_Unknown);
  52.  
  53.     function TCPNameToAddr (var hostName: str255; timeout: longInt): longInt;
  54.     function TCPOpenResolver (var dataptr: ptr): OSErr;
  55.     function TCPStrToAddr (dataptr: ptr; var hostName: str255; var rtnStruct: hostInfo; var done: signedByte): OSErr;
  56.     procedure TCPAddrToStr (dataptr: ptr; addr: longInt; var addrStr: str255);
  57.     function TCPAddrToName (dataptr: ptr; addr: longInt; var rtnStruct: hostInfo; var done: signedByte): OSErr;
  58.     procedure TCPCloseResolver (dataptr: ptr);
  59.  
  60.     function C2PStr (s: stringPtr): stringPtr;
  61.     procedure SanitizeHostName (var s: str255);
  62.  
  63.     function TCPInit: OSErr;
  64.     procedure TCPFinish;
  65.     function TCPGetMyIPAddr (var myIP: longInt): OSErr;
  66.     function TCPActiveOpen (var connection: TCPConnectionPtr; buffersize: longInt; localport: integer; remoteIP: longInt; remoteport: integer; userptr: OSErrPtr): OSErr;
  67.     function TCPPassiveOpen (var connection: TCPConnectionPtr; buffersize: longInt; localport: integer; remoteIP: longInt; remoteport: integer; userptr: OSErrPtr): OSErr;
  68.     function TCPCreateConnectionForStream (var connection: TCPConnectionPtr; strm: streamPtr): OSErr;
  69.     function TCPFlush (connection: TCPConnectionptr): OSErr;
  70.     function TCPClose (connection: TCPConnectionPtr; userptr: OSErrPtr): OSErr;
  71.     function TCPAbort (connection: TCPConnectionPtr): OSErr;
  72.     function TCPRelease (var connection: TCPConnectionPtr): OSErr;
  73.     procedure TCPRawState (connection: TCPConnectionPtr; var state: integer; var localhost: longInt; var localport: integer; var remotehost: longInt; var remoteport: integer; var available: longInt);
  74.     function TCPState (connection: TCPConnectionPtr): TCPStateType;
  75.     function TCPCharsAvailable (connection: TCPConnectionPtr): longInt;
  76.     function TCPLocalPort (connection: TCPConnectionPtr): integer;
  77.     function TCPRawReceiveChars (connection: TCPConnectionPtr; returnPtr: ptr; readCount: integer): OSErr;
  78. { Use EITHER RawReceive, or the other Receives.  Don't combine them for one stream! }
  79.     function TCPReceiveChars (connection: TCPConnectionPtr; returnPtr: ptr; readCount: integer): OSErr;
  80.     function TCPReadByte (connection: TCPConnectionPtr; timeout: longInt; var b: SignedByte): OSErr;
  81.     function TCPReceiveUpTo (connection: TCPConnectionPtr; termChar: signedByte;{}
  82.                                     charTimeOut: longInt; readPtr: ptr; readSize: longInt; var readPos: longInt;{}
  83.                                     var gottermchar: boolean): OSErr;
  84.     function TCPSend (connection: TCPConnectionPtr; writePtr: ptr; writeCount: integer; push: boolean): OSErr;
  85.     function TCPSendAsync (connection: TCPConnectionPtr; writePtr: ptr; writeCount: integer; push: boolean; userptr: OSErrPtr): OSErr;
  86.  
  87. implementation
  88.  
  89. {    Loosely based on code by Harry Chesley 12/88, thus Copyright ⌐ 1988 Apple Computer, Inc.}
  90. {    Converted to sensible pascal interface 7/91 by Peter Lewis, thus also Copyright ⌐ 1991 Peter Lewis }
  91.  
  92.     const
  93.         MAGICNUMBER = 'TMGK';    { Unique value used to trap illegal connection IDs. }
  94.         dispose_block_max = 100;
  95.  
  96.     type
  97.         MyControlBlockArray = array[1..control_block_max] of MyControlBlockPtr;
  98.  
  99.     var
  100.         driver_refnum: integer;
  101.         controlblocks: MyControlBlockArray;
  102.         max_dispose_block: integer;
  103.         disposeblocks: array[1..dispose_block_max] of ptr;
  104.  
  105.     procedure SanitizeHostName (var s: str255);
  106.         var
  107.             dummysp: stringPtr;
  108.     begin
  109.         dummysp := C2PStr(@s);
  110. {$PUSH}
  111. {$R-}
  112.         if s[Length(s)] = '.' then
  113.             s[0] := chr(Length(s) - 1);
  114. {$POP}
  115.     end;
  116.  
  117.     function GetA6: ptr;
  118.     inline
  119.         $2F4E, $0000;
  120.  
  121.     procedure CallCompletion (cbp: MyControlBlockPtr; addr: procPtr);
  122.     inline
  123.         $205F, $4E90;
  124.  
  125. {$PUSH}
  126. {$D-}
  127.     procedure IOCompletion; { All C functions look like pascal paramterless procedures from the procs point of view }
  128.         type
  129.             stackframe = packed record
  130.                     frameptr: ptr;
  131.                     returnptr: ptr;
  132.                     paramblockptr: MyControlBlockPtr;
  133.                 end;
  134.             stackframeptr = ^stackframe;
  135.         var
  136.             a6: stackframeptr;
  137.             cbp: MyControlBlockPtr;
  138.     begin
  139.         a6 := stackframeptr(GetA6);
  140.         cbp := a6^.paramblockptr;
  141.         with cbp^ do begin
  142.             if userptr <> nil then
  143.                 userptr^ := cbp^.tcp.ioResult;
  144.             inuse := false;
  145.             if proc <> nil then
  146.                 CallCompletion(cbp, proc);
  147.         end;
  148.     end;
  149.  
  150.     procedure ZotBlocks;
  151.     begin
  152.         while max_dispose_block > 0 do begin
  153.             DisposPtr(disposeblocks[max_dispose_block]);
  154.             max_dispose_block := max_dispose_block - 1;
  155.         end;
  156.     end;
  157.  
  158.     procedure AddBlock (p: univ ptr);
  159.     begin
  160.         if max_dispose_block < dispose_block_max then begin
  161.             max_dispose_block := max_dispose_block + 1;
  162.             disposeblocks[max_dispose_block] := p;
  163.         end;
  164.     end;
  165.  
  166.     procedure ZeroCB (var cb: TCPControlBlock; stream: StreamPtr; call: integer);
  167.     { Zero out the control block parameters. }
  168.         var
  169.             i: integer;
  170.             p: longInt;
  171.     begin
  172.         ZotBlocks;
  173.         for p := longInt(@cb) to longInt(@cb) + SizeOf(TCPControlBlock) - 1 do
  174.             ptr(p)^ := 0;
  175.         cb.tcpStream := stream;
  176.         cb.ioCRefNum := driver_refnum;
  177.         cb.csCode := call;
  178.     end;
  179.  
  180.     function GetCB (var cbp: MyControlBlockPtr; tcpc: TCPConnectionPtr; call: integer; userptr: OSErrPtr; proc: procptr): OSErr;
  181. { NOTE: Must not move memory if there is a free block available (ie, during a Completion call) }
  182.         var
  183.             i: integer;
  184.     begin
  185.         i := 1;
  186.         while (i < control_block_max) & (controlblocks[i] <> nil) & controlblocks[i]^.inuse do
  187.             i := i + 1;
  188.         cbp := controlblocks[i];
  189.         if cbp = nil then begin
  190.             cbp := MyControlBlockPtr(NewPtr(SizeOf(MyControlBlock)));
  191.             if cbp <> nil then begin
  192.                 cbp^.inuse := false;
  193.                 controlblocks[i] := cbp;
  194.             end;
  195.         end;
  196.         if (cbp <> nil) & not cbp^.inuse then begin
  197.             ZeroCB(cbp^.tcp, tcpc^.stream, call);
  198.             cbp^.tcp.ioCompletion := @IOCompletion;
  199.             cbp^.inuse := true;
  200.             cbp^.userptr := userptr;
  201.             cbp^.tcpc := tcpc;
  202.             cbp^.proc := proc;
  203.             if userptr <> nil then
  204.                 userptr^ := inprogress;
  205.             GetCB := noErr;
  206.         end
  207.         else begin
  208.             cbp := nil;
  209.             GetCB := memFullErr;
  210.         end;
  211.     end;
  212.  
  213.     procedure FreeCB (var cbp: MyControlBlockPtr);
  214.     begin
  215.         if cbp <> nil then
  216.             cbp^.inuse := false;
  217.         cbp := nil;
  218.     end;
  219. {$POP}
  220.  
  221. {$S Init}
  222.     function TCPInit: OSErr;
  223.         var
  224.             oe: OSErr;
  225.             i: integer;
  226.     begin
  227.         max_dispose_block := 0;
  228.         oe := OpenDriver('.IPP', driver_refnum);
  229.         for i := 1 to control_block_max do
  230.             controlblocks[i] := nil;
  231.         TCPInit := oe;
  232.     end;
  233.  
  234. {$S Term}
  235.     procedure TCPFinish;
  236.         var
  237.             i: integer;
  238.     begin
  239.         for i := 1 to control_block_max do
  240.             if controlblocks[i] <> nil then begin
  241.                 DisposPtr(ptr(controlblocks[i]));
  242.                 controlblocks[i] := nil;
  243.             end;
  244.     end;
  245.  
  246. {$S}
  247.     procedure DestroyConnection (var connection: TCPConnectionPtr);
  248.     begin
  249.         connection^.magic := '????';
  250.         if connection^.buffer <> nil then
  251.             DisposPtr(ptr(connection^.buffer));
  252.         DisposPtr(Ptr(connection));
  253.         connection := nil;
  254.     end;
  255.  
  256.     function ValidateConnection (connection: TCPConnectionPtr): OSErr;
  257.     begin
  258.         if connection = nil then
  259.             ValidateConnection := connectionDoesntExist
  260.         else if connection^.magic <> MAGICNUMBER then
  261.             ValidateConnection := connectionDoesntExist
  262.         else
  263.             ValidateConnection := noErr;
  264.     end;
  265.  
  266.     function PBControlSync (var cb: TCPControlBlock): OSErr;
  267.     begin
  268.         PBControlSync := PBControl(@cb, false);
  269.     end;
  270.  
  271. {$PUSH}
  272. {$D-}
  273.     function PBControlAsync (var cbp: MyControlBlockPtr): OSErr;
  274.         var
  275.             oe: OSErr;
  276.     begin
  277.         oe := PBControl(ParmBlkPtr(cbp), true);
  278.         if oe <> noErr then
  279.             FreeCB(cbp);
  280.         PBControlAsync := oe;
  281.     end;
  282. {$POP}
  283.  
  284.     function TCPGetMyIPAddr (var myIP: longInt): OSErr;
  285.         var
  286.             cb: TCPControlBlock;
  287.             oe: OSErr;
  288.     begin
  289.         ZeroCB(cb, nil, TCPcsGetMyIP);
  290.         oe := PBControlSync(cb);
  291.         myIP := cb.getmyip.ourAddress;
  292.         TCPGetMyIPAddr := oe;
  293.     end;
  294.  
  295.     procedure SetUserPtr (userptr: OSErrPtr; oe: OSErr);
  296.     begin
  297.         if userptr <> nil then begin
  298.             if oe <> noErr then
  299.                 userptr^ := oe;
  300.         end;
  301.     end;
  302.  
  303.     function TCPCreateConnectionForStream (var connection: TCPConnectionPtr; strm: streamPtr): OSErr;
  304.         var
  305.             oe: OSErr;
  306.     begin
  307.         connection := TCPConnectionPtr(NewPtr(sizeof(TCPConnectionType)));
  308.         if connection = nil then
  309.             oe := memFullErr
  310.         else begin
  311.             oe := noErr;
  312.             with connection^ do begin
  313.                 buffer := nil;
  314.                 magic := MAGICNUMBER;
  315.                 asends := 0;
  316.                 asendcompletes := 0;
  317.                 closedone := false;
  318.                 incomingSize := 0;
  319.                 stream := strm;
  320.             end;
  321.         end;
  322.         if (oe <> noErr) and (connection <> nil) then
  323.             DestroyConnection(connection);
  324.         TCPCreateConnectionForStream := oe;
  325.     end;
  326.  
  327.     function CreateStream (var connection: TCPConnectionPtr; buffersize: longInt): OSErr;
  328.         var
  329.             oe: OSErr;
  330.             cb: TCPControlBlock;
  331.     begin
  332.         connection := TCPConnectionPtr(NewPtr(sizeof(TCPConnectionType)));
  333.         if connection = nil then
  334.             oe := memFullErr
  335.         else
  336.             with connection^ do begin
  337.                 buffer := NewPtr(buffersize);
  338.                 if buffer = nil then begin
  339.                     oe := memFullErr;
  340.                     DisposPtr(ptr(connection));
  341.                     connection := nil;
  342.                 end
  343.                 else begin
  344.                     magic := MAGICNUMBER;
  345.                     asends := 0;
  346.                     asendcompletes := 0;
  347.                     closedone := false;
  348.                     incomingSize := 0;
  349.                     ZeroCB(cb, nil, TCPcsCreate);
  350.                     cb.create.rcvBuff := buffer;
  351.                     cb.create.rcvBuffLen := buffersize;
  352.                     oe := PBControlSync(cb);
  353.                     stream := cb.tcpStream;
  354.                 end;
  355.             end;
  356.         if (oe <> noErr) and (connection <> nil) then
  357.             DestroyConnection(connection);
  358.         CreateStream := oe;
  359.     end;
  360.  
  361.     function PAOpen (var connection: TCPConnectionPtr; cs: integer; buffersize: longInt; localport: integer; remoteIP: longInt; remoteport: integer; userptr: OSErrPtr): OSErr;
  362.         var
  363.             oe, ooe: OSErr;
  364.             cbp: MyControlBlockPtr;
  365.             cb: TCPControlBlock;
  366.     begin
  367.         oe := CreateStream(connection, buffersize);
  368.         if oe = noErr then begin
  369.             with connection^ do begin
  370.                 oe := GetCB(cbp, connection, cs, userptr, nil);
  371.                 if oe = noErr then begin
  372.                     cbp^.tcp.open.localPort := localPort;
  373.                     cbp^.tcp.open.remoteHost := remoteIP;
  374.                     cbp^.tcp.open.remotePort := remoteport;
  375.                     oe := PBControlAsync(cbp);
  376.                 end;
  377.                 if oe <> noErr then begin
  378.                     ZeroCB(cb, stream, TCPcsRelease);
  379.                     ooe := PBControlSync(cb);
  380.                     DestroyConnection(connection);
  381.                 end;
  382.             end;
  383.         end;
  384.         SetUserPtr(userptr, oe);
  385.         PAOpen := oe;
  386.     end;
  387.  
  388. { Open a connection to another machine }
  389.     function TCPActiveOpen (var connection: TCPConnectionPtr; buffersize: longInt; localport: integer; remoteIP: longInt; remoteport: integer; userptr: OSErrPtr): OSErr;
  390.     begin
  391.         TCPActiveOpen := PAOpen(connection, TCPcsActiveOpen, buffersize, localport, remoteIP, remoteport, userptr);
  392.     end;
  393.  
  394. { Open a socket on this machine, to wait for a connection }
  395.     function TCPPassiveOpen (var connection: TCPConnectionPtr; buffersize: longInt; localport: integer; remoteIP: longInt; remoteport: integer; userptr: OSErrPtr): OSErr;
  396.     begin
  397.         TCPPassiveOpen := PAOpen(connection, TCPcsPassiveOpen, buffersize, localport, remoteIP, remoteport, userptr);
  398.     end;
  399.  
  400.     function TCPRawReceiveChars (connection: TCPConnectionPtr; returnPtr: ptr; readCount: integer): OSErr;
  401. { Return readCount characters from the TCP connection. }
  402. { WARNING: Doesnt handle incoming buffer, so don't use with TCPReceiveUptp or ReadByte }
  403.         var
  404.             cb: TCPControlBlock;
  405.             oe: OSErr;
  406.     begin
  407.         repeat
  408.             ZeroCB(cb, connection^.stream, TCPcsRcv);
  409.             cb.receive.rcvBuff := returnPtr;
  410.             cb.receive.rcvBuffLength := readCount;
  411.             oe := PBControlSync(cb);
  412.             longInt(returnPtr) := longInt(returnPtr) + cb.receive.rcvBuffLength;
  413.             readCount := readCount - cb.receive.rcvBuffLength;
  414.         until (oe <> noErr) or (readCount = 0);
  415.         TCPRawReceiveChars := oe;
  416.     end;
  417.  
  418. { Return readCount characters from the TCP connection.}
  419.     function TCPReceiveChars (connection: TCPConnectionPtr; returnPtr: ptr; readCount: integer): OSErr;
  420.         var
  421.             readCountStr: Str255;
  422.             l: longInt;
  423.             p: Ptr;
  424.             oe: OSErr;
  425.             cb: TCPControlBlock;
  426.     begin
  427.         oe := ValidateConnection(connection);
  428.         if oe = noErr then
  429.             if readCount < 0 then
  430.                 oe := invalidLength
  431.             else if readCount > 0 then begin
  432.                 p := returnPtr;
  433.                 with connection^ do
  434.                     if incomingSize > 0 then begin
  435.             { Read as much as there is or as much as we need, whichever is less. }
  436.                         if readCount < incomingSize then
  437.                             l := readCount
  438.                         else
  439.                             l := incomingSize;
  440.                         BlockMove(incomingPtr, p, l);
  441.                         incomingPtr := Ptr(ord4(incomingPtr) + l);
  442.                         incomingSize := incomingSize - l;
  443.                         p := Ptr(ord4(p) + l);
  444.                         readCount := readCount - l;
  445.                     end;
  446.                 { If there's more needed, then read it from the connection. }
  447.                 if readCount > 0 then begin
  448.                         { Issue a read and wait until it all arrives). }
  449.                     oe := TCPRawReceiveChars(connection, p, readCount);
  450.                 end;
  451.             end;
  452.         TCPReceiveChars := oe;
  453.     end;
  454.  
  455.     function TCPReadByte (connection: TCPConnectionPtr; timeout: longInt; var b: SignedByte): OSErr;
  456.         { Return the next byte in the buffer, reading more in if necessary. }
  457.         var
  458.             waitUntil: longInt;
  459.             readIn: longInt;
  460.             oe: OSErr;
  461.             cb: TCPControlBlock;
  462.     begin
  463.         oe := ValidateConnection(connection);
  464.         if oe = noErr then
  465.             with connection^ do begin            { Check if we need to read in more bytes. }
  466.                 if incomingSize = 0 then begin
  467.                     if (timeout = 0) and (TCPCharsAvailable(connection) = 0) then
  468.                         oe := commandTimeout
  469.                     else begin
  470.                         waitUntil := TickCount + timeout;
  471.     { keep on trying to read until we get at least one, or the time-out happens. }
  472.                         while (oe = noErr) and (incomingSize = 0) do begin                { Get the status. }
  473.                             readIn := TCPCharsAvailable(connection);    { If there's something there to read, do so. }
  474.                             if readIn > 0 then begin    { Don't read any more than will fit in the buffer. }
  475.                                 if readIn > INCOMINGBUFSIZE then
  476.                                     readIn := INCOMINGBUFSIZE;
  477.                         { Issue the read. }
  478.                                 oe := TCPRawReceiveChars(connection, @inBuf, readIn);
  479.                                 if oe = noErr then begin
  480.                                     incomingSize := readIn;
  481.                                     incomingPtr := @inBuf;
  482.                                 end;
  483.                             end        { If not, do another round or get out, depending on the timeout condition. }
  484.                             else if TickCount > waitUntil then begin
  485.                                 oe := commandTimeOut;
  486.                             end;
  487.                         end;
  488.                     end;
  489.                 end;
  490.                 { Get the byte to return. }
  491.                 if incomingSize > 0 then begin
  492.                     b := incomingPtr^;
  493.                     incomingPtr := Ptr(ord4(incomingPtr) + 1);
  494.                     incomingSize := incomingSize - 1;
  495.                 end
  496.                 else
  497.                     b := 0;
  498.             end;
  499.         TCPReadByte := oe;
  500.     end;
  501.  
  502. { Pass in a block of memory (readPtr,readSize), already containing readPos bytes}
  503. { TCPReceiveUpTo will then read characters until a termChar character is reached,}
  504. { or until waitForChars ticks go by without receiving any bytes.  If waitForChars is}
  505. { zero, then TCPReceiveUpTo will return immediately.  If termChar=0, then it}
  506. { will read the entire buffer, and any characters that arrive before a timeout }
  507.     function TCPReceiveUpTo (connection: TCPConnectionPtr; termChar: signedByte;{}
  508.                                     charTimeOut: longInt; readPtr: ptr; readSize: longInt; var readPos: longInt;{}
  509.                                     var gottermchar: boolean): OSErr;
  510.         var
  511.             oe: OSErr;
  512.             inChar: SignedByte;
  513.             p: Ptr;
  514.     begin
  515.         oe := ValidateConnection(connection);
  516.         gottermchar := false;
  517.         if oe = noErr then begin
  518. { Cycle until the timeout happens or we see the termintor character or we run out of room. }
  519.             while (oe = noErr) and (readPos < readSize) and not gottermchar do begin            { Get the next character. }
  520.                 oe := TCPReadByte(connection, charTimeOut, inChar);                    { Ignore the character if it's a zero. }
  521.                 if (oe = noErr) and (inChar <> 0) then begin            { Put it in the result. }
  522.                     p := Ptr(ord4(readPtr) + readPos);
  523.                     p^ := inChar;
  524.                     readPos := readPos + 1;
  525.                     gottermchar := inChar = termChar;
  526.                 end;
  527.             end;
  528.             if oe = commandTimeOut then
  529.                 oe := noErr;
  530.         end;
  531.         TCPReceiveUpTo := oe;
  532.     end;
  533.  
  534.     function TCPSend (connection: TCPConnectionPtr; writePtr: ptr; writeCount: integer; push: boolean): OSErr;
  535.         var
  536.             wds: wdsType;
  537.             oe: OSErr;
  538.             cb: TCPControlBlock;
  539.             p: ptr;
  540.     begin
  541.         oe := ValidateConnection(connection);
  542.         if oe = nOErr then
  543.             if writeCount > 0 then begin
  544.                 wds.buffer := writePtr;
  545.                 wds.size := writeCount;
  546.                 wds.term := 0;
  547.                 ZeroCB(cb, connection^.stream, TCPcsSend);
  548.                 cb.send.wds := @wds;
  549.                 cb.send.pushFalg := ord(push);
  550.                 oe := PBControlSync(cb);
  551.             end
  552.             else if writeCount < 0 then
  553.                 oe := InvalidLength;
  554.         TCPSend := oe;
  555.     end;
  556.  
  557. {$PUSH}
  558. {$D-}
  559.     procedure TCPSendComplete (cbp: MyControlBlockPtr);
  560.         var
  561.             oe: OSErr;
  562.     begin
  563.         AddBlock(cbp^.tcp.send.wds);
  564.         with cbp^.tcpc^ do begin
  565.             asendcompletes := asendcompletes + 1;
  566.             if (asendcompletes = asends) and closedone then begin
  567.                 oe := GetCB(cbp, cbp^.tcpc, TCPcsClose, closeuserptr, nil);
  568. { GetCB won't NewPtr because the completion has just released a block }
  569.                 if oe = noErr then begin
  570.                     oe := PBControlAsync(cbp);
  571.                 end;
  572.             end;
  573.         end;
  574.     end;
  575. {$POP}
  576.  
  577.     function TCPSendAsync (connection: TCPConnectionPtr; writePtr: ptr; writeCount: integer; push: boolean; userptr: OSErrPtr): OSErr;
  578.         type
  579.             myblock = record
  580.                     wds: wdsType;
  581.                     data: array[0..100] of byte;
  582.                 end;
  583.             myblockptr = ^myblock;
  584.         var
  585.             oe: OSErr;
  586.             cbp: MyControlBlockPtr;
  587.             p: myblockptr;
  588.     begin
  589.         oe := ValidateConnection(connection);
  590.         if oe = nOErr then
  591.             if writeCount > 0 then begin
  592.                 p := myblockptr(NewPtr(writeCount + SizeOf(wdsType)));
  593.                 if p = nil then
  594.                     oe := memFullErr
  595.                 else begin
  596.                     p^.wds.buffer := @p^.data;
  597.                     p^.wds.size := writeCount;
  598.                     p^.wds.term := 0;
  599.                     with p^.wds do
  600.                         BlockMove(writePtr, buffer, size);
  601.                     oe := GetCB(cbp, connection, TCPcsSend, userptr, @TCPSendComplete);
  602.                     cbp^.tcp.send.wds := POINTER(p);
  603.                     cbp^.tcp.send.pushFalg := ord(push);
  604.                     with connection^ do
  605.                         asends := asends + 1;
  606.                     oe := PBControlAsync(cbp);
  607.                     if oe <> noErr then
  608.                         DisposPtr(ptr(p));
  609.                 end;
  610.             end
  611.             else if writeCount < 0 then
  612.                 oe := InvalidLength;
  613.         TCPSendAsync := oe;
  614.     end;
  615.  
  616.     function TCPClose (connection: TCPConnectionPtr; userptr: OSErrPtr): OSErr;
  617.         var
  618.             oe: OSErr;
  619.             cbp: MyControlBlockPtr;
  620.     begin
  621.         oe := ValidateConnection(connection);
  622.         if oe = noErr then
  623.             with connection^ do begin
  624.                 closeuserptr := userptr;
  625.                 if userptr <> nil then
  626.                     userptr^ := inProgress;
  627.                 closedone := true;
  628.                 if asends = asendcompletes then begin
  629.                     oe := GetCB(cbp, connection, TCPcsClose, userptr, nil);
  630.                     if oe = noErr then begin
  631.                         oe := PBControlAsync(cbp);
  632.                     end;
  633.                 end;
  634.             end;
  635.         SetUserPtr(userptr, oe);
  636.         TCPClose := oe;
  637.     end;
  638.  
  639.     function TCPAbort (connection: TCPConnectionPtr): OSErr;
  640.         var
  641.             oe: OSErr;
  642.             cb: TCPControlBlock;
  643.     begin
  644.         oe := ValidateConnection(connection);
  645.         if oe = noErr then begin
  646.             ZeroCB(cb, connection^.stream, TCPcsAbort);
  647.             oe := PBControlSync(cb);
  648.         end;
  649.         TCPAbort := oe;
  650.     end;
  651.  
  652. { Release the TCP stream, including the buffer.}
  653.     function TCPRelease (var connection: TCPConnectionPtr): OSErr;
  654.         var
  655.             oe: OSErr;
  656.             cb: TCPControlBlock;
  657.     begin
  658.         oe := ValidateConnection(connection);
  659.         if oe = noErr then begin
  660.             ZeroCB(cb, connection^.stream, TCPcsRelease);
  661.             oe := PBControlSync(cb);
  662.             DestroyConnection(connection);
  663.         end;
  664.         TCPRelease := oe;
  665.     end;
  666.  
  667. {    TCPRawState(connectionID) -- Return the state of the TCP connection.}
  668.     procedure TCPRawState (connection: TCPConnectionPtr; var state: integer; var localhost: longInt; var localport: integer; var remotehost: longInt; var remoteport: integer; var available: longInt);
  669.         var
  670.             cb: TCPControlBlock;
  671.             oe: OSErr;
  672.     begin
  673.         oe := ValidateConnection(connection);
  674.         localhost := 0;
  675.         localport := 0;
  676.         remotehost := 0;
  677.         remoteport := 0;
  678.         available := 0;
  679.         if oe <> noErr then begin
  680.             state := 99; { Error -> Closed }
  681.         end
  682.         else begin
  683.             ZeroCB(cb, connection^.stream, TCPcsStatus);
  684.             if PBControlSync(cb) <> noErr then begin
  685.                 state := 99; { Closed }
  686.             end
  687.             else begin
  688.                 state := cb.status.connectionState;
  689.                 connection^.laststate := state;
  690.                 localhost := cb.status.localhost;
  691.                 localport := cb.status.localport;
  692.                 remotehost := cb.status.remotehost;
  693.                 remoteport := cb.status.remoteport;
  694.                 available := cb.status.amtUnreadData + connection^.incomingSize;
  695.             end;
  696.         end;
  697.     end;
  698.  
  699. { Return the state of the TCP connection.}
  700.     function TCPState (connection: TCPConnectionPtr): TCPStateType;
  701.         var
  702.             state: integer;
  703.             localhost: longInt;
  704.             localport: integer;
  705.             remotehost: longInt;
  706.             remoteport: integer;
  707.             available: longInt;
  708.     begin
  709.         TCPRawState(connection, state, localhost, localport, remotehost, remoteport, available);
  710.         case state of
  711.             0: 
  712.                 TCPState := T_Closed;
  713.             2: 
  714.                 TCPState := T_Listening;
  715.             4, 6: 
  716.                 TCPState := T_Opening;
  717.             8: 
  718.                 TCPState := T_Established;
  719.             10, 12, 16, 18, 20: 
  720.                 TCPState := T_Closing;
  721.             14: 
  722.                 TCPState := T_PleaseClose;
  723.             98: 
  724.                 TCPState := T_WaitingForOpen;
  725.             99: 
  726.                 TCPState := T_Closed;
  727.             otherwise
  728.                 TCPState := T_Unknown;
  729.         end;
  730.     end;
  731.  
  732. {    Return the number of characters available for reading from the TCP connection.}
  733.     function TCPCharsAvailable (connection: TCPConnectionPtr): longInt;
  734.         var
  735.             state: integer;
  736.             localhost: longInt;
  737.             localport: integer;
  738.             remotehost: longInt;
  739.             remoteport: integer;
  740.             available: longInt;
  741.     begin
  742.         TCPRawState(connection, state, localhost, localport, remotehost, remoteport, available);
  743.         TCPCharsAvailable := available;
  744.     end;
  745.  
  746.     function TCPLocalPort (connection: TCPConnectionPtr): integer;
  747.         var
  748.             state: integer;
  749.             localhost: longInt;
  750.             localport: integer;
  751.             remotehost: longInt;
  752.             remoteport: integer;
  753.             available: longInt;
  754.     begin
  755.         TCPRawState(connection, state, localhost, localport, remotehost, remoteport, available);
  756.         TCPLocalPort := localport;
  757.     end;
  758.  
  759.     function TCPFlush (connection: TCPConnectionptr): OSErr;
  760.         var
  761.             buffer: array[0..255] of signedByte;
  762.             f: longInt;
  763.             oe: OSErr;
  764.     begin
  765.         f := TCPCharsAvailable(connection);
  766.         oe := noErr;
  767.         while (f > 0) and (oe = noErr) do begin
  768.             if f > 256 then
  769.                 f := 256;
  770.             oe := TCPReceiveChars(connection, @buffer, f);
  771.             if oe = noErr then
  772.                 f := TCPCharsAvailable(connection);
  773.         end;
  774.         TCPFlush := oe;
  775.     end;
  776.  
  777. end.
  778. function TCPNameToAddr (var hostName: str255; timeout: longInt; var hostFile: str255): longInt;
  779.     function TCPOpenResolver (var hostFile: str255; var dataptr: ptr): OSErr;
  780.         function TCPStrToAddr (dataptr: ptr; var hostName: str255; var rtnStruct: hostInfo; var done: signedByte): OSErr;
  781.             procedure TCPAddrToStr (dataptr: ptr; addr: longInt; var addrStr: str255);
  782.                 function TCPAddrToName (dataptr: ptr; addr: longInt; var rtnStruct: hostInfo; var done: signedByte): OSErr;
  783.                     procedure TCPCloseResolver (dataptr: ptr);